Collection of Tools & Utilities/Collection of Tools and Utilities.iso/comm/odys200a.zip/ODY200SH.LZH/ODYHOST.HSC

Text File | 1993-04-26 | 12KB | 452 lines

SCRIPT OdyHost;

(************************************************************************)
(*                                                                      *)
(*                     Odyssey Host Mode Script                         *)
(*                Copyright (c) Don Milne, July 1990                    *)
(*                                                                      *)
(************************************************************************)

VAR DefaultBaudRate:Number;
    GotLeaveCmd,PrivUser,LostCarrier:Flag;
    CurrDir,OrigDir:String;
    FileOK,GotChar,Carrier,AlreadyConnected,Busy:Flag;
    OldCrMode:Number;

(* Host mode info, configured in Odyssey by user *)
VAR NormPass,PrivPass,Welcome,HostDir:String;
    MNPwanted:Flag;

(*.........................................*)

FUNC CarrierLost():Flag;

VAR tempcarrier:Flag;

BEGIN
     IF LostCarrier THEN RETURN(TRUE) END;
     tempcarrier := OnLine();
     IF (Carrier<>tempcarrier) AND (NOT tempcarrier) THEN
         Delay(1);
         IF NOT OnLine() THEN
             LostCarrier:=TRUE;
             Carrier := FALSE;
             AlreadyConnected := FALSE;
             RETURN TRUE
         END;
     END;
     RETURN FALSE;
END;

(*.........................................*)

PROC SendString(s:String);
BEGIN
     Write(s); Transmit(s);
END;

(*.........................................*)

FUNC GetString(VAR s:String; Timout:Number):Flag;
BEGIN
     IF Receive(s,Timout) THEN
         Write(s+"|");
         RETURN TRUE;
     END;
     RETURN FALSE;
END;

(*.........................................*)

FUNC LeaveHostMode():Flag;
BEGIN
     IF NOT GotLeaveCmd THEN
         WHILE KeyPressed() DO (* leave host mode? *)
             IF RdKey()=27 THEN
                 GotLeaveCmd := TRUE;
             END;
         END;
     END;
     RETURN GotLeaveCmd;
END;

(*.........................................*)

FUNC GetPassWord():Flag;

VAR Attempts:Number;
    GotPassword,Failure:Flag;
    Password:String[20];

BEGIN
     PrivUser := FALSE;
     GotPassword := FALSE;
     Failure := FALSE;
     Attempts := 0;
     REPEAT
           SendString("|Enter Password: ");
           Receive(Password,10,NoEcho);
           IF Password = PrivPass THEN
               PrivUser := TRUE;
               GotPassword := TRUE
             ELSIF Password = NormPass THEN
               GotPassword := TRUE
             ELSE
               SendString("Incorrect ("+Password+")"); INC(Attempts);
               Failure := (Attempts>=3);
               IF Failure THEN
                   SendString("||Wrong too often.. Byeee|");
                   HangUp();
               END;
           END
     UNTIL GotPassword OR Failure;
     RETURN GotPassword;
END;

(*.........................................*)

PROC ChangeDirectory();

VAR Temp:String;

BEGIN
     SendString("|Directory? ");
     IF GetString(Temp,30) THEN
         IF Temp="" THEN RETURN END;
         IF ChDir(Temp) THEN
             CurrDir := Temp
           ELSE
             SendString("No such directory");
             ChDir(CurrDir);
         END;
     END;
END;

(*.........................................*)

PROC DirectoryListing();

VAR Lines,Count,f_attr:Number;
    GotFile:Flag;
    Temp:String;
    Name:String[20];

BEGIN
     SendString("Dir Mask? ");
     IF NOT GetString(Temp,30) THEN RETURN END;
     SendString('|');
     IF Temp="" THEN Temp:="*.*" END;
     GotFile := FFirst(Temp,0,Name,f_attr);
     IF GotFile THEN
         Count:=0; Lines:=0;
         WHILE (GotFile) AND (NOT CarrierLost()) DO
             Temp := Name;
             Temp := SubStr(Temp+"              ",0,14);
             SendString(Temp);
             GotFile := FNext(Name,f_attr);
             INC(Count);
             IF Count % 5 = 0 THEN
                 INC(Lines); SendString('|');
                 IF Lines=20 THEN
                     SendString("||More...");
                     GetString(temp,30);
                     IF CarrierLost() THEN RETURN END;
                     SendString('||');
                 END;
             END;
         END;
       ELSE
         SendString("No matching files.|");
     END;
     SendString('||');
END;

(*................................................*)

FUNC GetFilename(VAR Filename:String; MustExist:Flag):Flag;
BEGIN
     SendString("|Filename? ");
     IF NOT GetString(Filename,30) THEN
         SendString('|');
       ELSE
         IF (Length(Filename)>12) OR (Pos(":",Filename)>=0) OR (Pos("\",Filename)>=0) THEN
             (* for security reasons, path and drive names are not allowed *)
             SendString("|Bad File name|");
             RETURN FALSE;
         END;
         IF IsFile(Filename) THEN
             IF MustExist THEN
                 RETURN TRUE
               ELSE
                 SendString("|Filename used already - pick another!|");
             END;
           ELSIF MustExist THEN
             SendString("|File not found.|");
           ELSE
             RETURN TRUE
         END;
     END;
     RETURN FALSE;
END;

(*................................................*)

FUNC GetFTMethod(AsciiOK:Flag):Number;

VAR c:String[2];
    x:Number;

BEGIN
     SendString("Choose method=>|");
     IF AsciiOK THEN SendString("A(scii|") END;
     SendString("X(modem|W(xmodem|Y(modem|B(atch Ymodem|K(ermit|Z(modem|?");
     REPEAT
           IF NOT GetString(c,30) THEN
               RETURN -1;
             ELSIF c<>"" THEN
               x:=Pos(ToUpper(c),"AXYBWKZ");
             ELSIF CarrierLost() THEN
               RETURN -1;
           END;
     UNTIL ((x=0) AND (AsciiOK)) OR ((x>=1) AND (x<=6));
     RETURN x;
END;

(*................................................*)

PROC SayProtocol(prot:Number; AddDelay:Flag);
BEGIN
     CASE prot OF
          0:SendString("ASCII");
       |  1:SendString("Xmodem");
       |  2:SendString("Ymodem");
       |  3:SendString("Ymodem Batch");
       |  4:SendString("WXmodem");
       |  5:SendString("Kermit");
       |  6:SendString("Zmodem");
     END;
     SendString(" protocol.|");
     IF AddDelay THEN Delay(5) END;
END;

(*................................................*)

PROC SayResult();
BEGIN
     SendString("|File Transfer ");
     IF FileOK THEN
         SendString("Complete.|")
       ELSE
         SendString("Failed.|")
     END;
END;

(*................................................*)

FUNC TransferFile(down:Flag; protocol:Number; FileSpec:String):Flag;
BEGIN
     IF down THEN
         RETURN Download(protocol,FileSpec,ResumeTransfer);
       ELSE
         RETURN Upload(Protocol,FileSpec);
     END;
END;

(*................................................*)

PROC GetFileFromUser();

VAR x:Number;
    Filename:String;

BEGIN
     x := GetFTMethod(FALSE);
     IF x<0 THEN RETURN END;
     IF (x=XMODEM) OR (x=WXMODEM) OR (x=YMODEM) THEN
         IF NOT GetFilename(Filename,FALSE) THEN RETURN END;
     END;
     SendString("|Ready to receive file using ");
     SayProtocol(x,FALSE);
     FileOK := TransferFile(TRUE,x,Filename);
     SayResult();
END;

(*................................................*)

PROC SendFileToUser();

VAR x:Number;
    f:File;
    blocks,bytes:String[10];
    Filename:String;

BEGIN
     x := GetFTMethod(TRUE);
     IF x<0 THEN RETURN END;
     IF NOT GetFilename(Filename,TRUE) THEN RETURN END;
     FOpen(f,Filename);
     FileSize(f,bytes,blocks);
     FClose(f);
     SendString("|File: "+Filename+"|  "+bytes+" bytes, ("+blocks+" Xmodem blocks).|");
     SendString("About to send file using ");
     SayProtocol(x,TRUE);
     Filename := FQualify(Filename);
     FileOK := TransferFile(FALSE,x,Filename);
     SayResult();
END;

(*................................................*)

PROC GetMenu();

VAR c:String[2];
    x:Number;

BEGIN
     REPEAT
           IF CarrierLost() OR LeaveHostMode() THEN RETURN END;
     UNTIL GetStr